home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue67 / Threads / MainForm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-01-05  |  3.3 KB  |  124 lines

  1. unit MainForm;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ComCtrls,
  8.   //My Units
  9.   BasicThread,HiddenWordThread,IntegerList;
  10.  
  11. type
  12.   TForm1 = class(TForm)
  13.     buPlay: TButton;
  14.     edtHiddenWord: TEdit;
  15.     LabelHiddenWord: TLabel;
  16.     edtNoOfOpponents: TEdit;
  17.     LabelNoOfOpponents: TLabel;
  18.     UpDownNoOfOpponents: TUpDown;
  19.     buStop: TButton;
  20.     StatusBar: TStatusBar;
  21.     procedure FormCreate(Sender: TObject);
  22.     procedure buPlayClick(Sender: TObject);
  23.     procedure buStopClick(Sender: TObject);
  24.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  25.   private
  26.    fHiddenWordThread:THiddenWordThread;
  27.    fThreadsWithAnswer:integer;
  28.    fOpponentThreadIDs:TIntegerList;
  29.    procedure ThreadGotAnswer(var Message:TMessage);message WM_Signal_ThreadGotAnswer;
  30.    procedure ThreadTerminating(var Message: TMessage);message WM_Signal_ThreadTerminating;
  31.    procedure SetfThreadsWithAnswer(const Value: integer);
  32.    property ThreadsWithAnswer:integer read fThreadsWithAnswer write SetfThreadsWithAnswer;
  33.   end;
  34.  
  35. var
  36.   Form1: TForm1;
  37.  
  38. implementation
  39.  
  40. uses OpponentThread;
  41.  
  42. {$R *.DFM}
  43.  
  44. procedure TForm1.FormCreate(Sender: TObject);
  45. begin
  46.  edtHiddenWord.Text:='';
  47.  edtNoOfOpponents.Text:='5';
  48.  fOpponentThreadIDs:=TIntegerList.Create;
  49.  Randomize;
  50. end;
  51.  
  52. procedure TForm1.buPlayClick(Sender: TObject);
  53. const
  54.  cSuspended=FALSE;
  55. var
  56.  i1:integer;
  57.  ThreadID:THandle;
  58. begin
  59.  if Length(edtHiddenWord.Text)=0then
  60.   raise exception.create('Please enter a word');
  61.  if Length(edtHiddenWord.Text)>30then
  62.   raise exception.create('Word length cannot be greater than 30 characters');
  63.  if StrToInt(edtNoOfOpponents.Text)<1then
  64.   raise exception.create('Must have at least one opponent thread');
  65.  if StrToInt(edtNoOfOpponents.Text)>200then
  66.   raise exception.create('Can''t have more than 200 opponent threads');
  67.  buPlay.Enabled:=FALSE;
  68.  buStop.Enabled:=TRUE;
  69.  ThreadsWithAnswer:=0;
  70.  fHiddenWordThread:=THiddenWordThread.Create(cSuspended,edtHiddenWord.Text);
  71.  for i1:=1to StrToInt(edtNoOfOpponents.Text)do
  72.  begin
  73.   TOpponentThread.Create(cSuspended,fHiddenWordThread.ThreadID,Handle,ThreadID);
  74.   fOpponentThreadIDs.Add(ThreadID)
  75.  end;
  76. end;
  77.  
  78. procedure TForm1.buStopClick(Sender: TObject);
  79. var
  80.  i1:integer;
  81. begin
  82.  if not buStop.Enabled then exit;
  83.  buStop.Enabled:=FALSE;
  84.  Screen.Cursor:=crHourGlass;
  85.  for i1:=0to fOpponentThreadIDs.count-1do
  86.   PostThreadMessage(fOpponentThreadIDs[i1],WM_Quit,0,0);
  87. end;
  88.  
  89. procedure TForm1.ThreadGotAnswer(var Message:TMessage) ;
  90. begin
  91.  ThreadsWithAnswer:=ThreadsWithAnswer+1;
  92. end;
  93.  
  94. procedure TForm1.SetfThreadsWithAnswer(const Value: integer);
  95. begin
  96.  fThreadsWithAnswer:=Value;
  97.  StatusBar.SimpleText:='Threads With Answer:'+IntToStr(fThreadsWithAnswer);
  98. end;
  99.  
  100. procedure TForm1.ThreadTerminating(var Message:TMessage);
  101. var
  102.  ThreadID:integer;
  103. begin
  104.  ThreadID:=Message.wParam;
  105.  fOpponentThreadIDs.Remove(ThreadID);
  106.  if fOpponentThreadIDs.Count=0then
  107.  begin
  108.   PostThreadMessage(fHiddenWordThread.ThreadID,WM_Quit,0,0);
  109.   buStop.Enabled:=FALSE;
  110.   buPlay.Enabled:=TRUE;
  111.   Screen.Cursor:=crDefault;
  112.  end;
  113. end;
  114.  
  115.  
  116. procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  117. begin
  118.  CanClose:=fOpponentThreadIDs.Count=0;
  119.  if not CanClose then
  120.   ShowMessage('Threads Still Running');
  121. end;
  122.  
  123. end.
  124.